library(compiler)
representer <- function(distances) {
 # computes representativeness as in Laver Sergenti
    min.distances <- apply(t(distances), 2, min)
    return(-mean(min.distances*min.distances))
}
representer <- cmpfun(representer)

gov.representer <- function(vpref, govdim1, govdim2, sum.dist.voter.median.voter) {
    distance.to.gov <- apply(vpref, 1, euclidean.distancer, unique(govdim1), unique(govdim2))
    return(1-(sum.dist.voter.median.voter/sum(distance.to.gov)))
}
gov.representer <- cmpfun(gov.representer)

voter <- function(distances){which.is.max(-distances)}
voter <- cmpfun(voter)

# Aggregator as on page 139 of Laver/Sergenti 2012
aggregator <- function(partydim1, partydim2, vprefdim1, vprefdim2, vote, p, speed){
    if (length(vprefdim1[vote==p])==0) { #if party has no voters, move toward center
        target1 <- .Internal(mean(vprefdim1))
        target2 <- .Internal(mean(vprefdim2))
    } else { #move toward mean supporter
       target1 <- .Internal(mean(vprefdim1[vote==p]))
       target2 <- .Internal(mean(vprefdim2[vote==p]))
    }
    distance.to.ideal <- sqrt((partydim1-target1)^2+(partydim2-target2)^2)
    if (distance.to.ideal <= speed) { #possible to reach target?
     new.partydim1 <- target1
     new.partydim2 <- target2
    } else { # move speed steps toward target
     ideal.direction1 <- target1-partydim1
     ideal.direction2 <- target2-partydim2   
     new.partydim1 <- partydim1+ ((speed/distance.to.ideal)*ideal.direction1)
     new.partydim2 <- partydim2+ ((speed/distance.to.ideal)*ideal.direction2)
     if (new.partydim1<0|new.partydim1>(sqrt(2)/2)) {
         new.partydim1 <- ifelse(new.partydim1<0, 0, (sqrt(2)/2))
     }
     if (new.partydim2<0|new.partydim2>(sqrt(2)/2)) {
         new.partydim2 <- ifelse(new.partydim2<0, 0, (sqrt(2)/2))
     }
    }
  return(list(partydim1=new.partydim1,
              partydim2=new.partydim2)
         )
}
aggregator <- cmpfun(aggregator)

##Hunter: win repeat move; lose elections: shift in opposite direction with a random twist
hunter <- function(electionst1, electionst2, partydim1, direction1, partydim2, direction2, speed){
      if (direction1==0&direction2==0) { #if party was sticker: assume random move was done
          direction1 <- sample(c(-1,1),1)
          direction2 <- sample(c(-1,1),1)
      } 
  if (electionst1<=electionst2) { #if loosing, turn round and make random move in 180�.
      angle <- 90 + runif(1, 0, 180)
      new.direction1 <- direction1*cos(angle)-direction2*sin(angle)
      new.direction2 <- direction1*sin(angle)+direction2*cos(angle)     
      direction1 <- new.direction1
      direction2 <- new.direction2
 } #else repeat last round's move
      length <- sqrt(direction1^2+direction2^2)
      direction1 <- direction1/length*speed
      direction2 <- direction2/length*speed
      new.partydim1 <- partydim1 + direction1
      new.partydim2 <- partydim2 + direction2
     if (new.partydim1<0|new.partydim1>(sqrt(2)/2)) {
         new.partydim1 <- ifelse(new.partydim1<0, 0, (sqrt(2)/2))
     }
     if (new.partydim2<0|new.partydim2>10) {
         new.partydim2 <- ifelse(new.partydim2<0, 0, (sqrt(2)/2))
     }
  return(list(partydim1=new.partydim1,
              partydim2=new.partydim2)
         )
}
hunter <- cmpfun(hunter)

#move toward government position, unless you're at it (e.g., single party government )
governator <- function(partydim1, partydim2, speed, govdim1, govdim2){
    distance.to.gov <- sqrt((partydim1-govdim1)^2+(partydim2-govdim2)^2)
    if (distance.to.gov <= speed) {
     new.partydim1 <- govdim1
     new.partydim2 <- govdim2
    } else { # move speed steps toward target
     gov.direction1 <- govdim1-partydim1
     gov.direction2 <- govdim2-partydim2   
     new.partydim1 <- partydim1+ ((speed/distance.to.gov)*gov.direction1)
     new.partydim2 <- partydim2+ ((speed/distance.to.gov)*gov.direction2) 
    }
     if (new.partydim1<0|new.partydim1>(sqrt(2)/2)) {
         new.partydim1 <- ifelse(new.partydim1<0, 0, (sqrt(2)/2))
     }
     if (new.partydim2<0|new.partydim2>(sqrt(2)/2)) {
         new.partydim2 <- ifelse(new.partydim2<0, 0, (sqrt(2)/2))
     }
  return(list(partydim1=new.partydim1,
              partydim2=new.partydim2)
         )     
 }
governator <- cmpfun(governator)

#move toward government position, unless you're a government member.
sat.governator <- function(partydim1, partydim2, speed, govdim1, govdim2, gov){
   if (gov==1) { #if gov member, stay put
       new.partydim1 <- partydim1
       new.partydim2 <- partydim2       
   } else { #move closer to gov position
      distance.to.gov <- sqrt((partydim1-govdim1)^2+(partydim2-govdim2)^2)
      if (distance.to.gov <= speed) {
       new.partydim1 <- govdim1
       new.partydim2 <- govdim2
      } else { # move speed steps toward target
       gov.direction1 <- govdim1-partydim1
       gov.direction2 <- govdim2-partydim2   
       new.partydim1 <- partydim1+ ((speed/distance.to.gov)*gov.direction1)
       new.partydim2 <- partydim2+ ((speed/distance.to.gov)*gov.direction2) 
      }
       if (new.partydim1<0|new.partydim1>(sqrt(2)/2)) {
           new.partydim1 <- ifelse(new.partydim1<0, 0, (sqrt(2)/2))
       }
       if (new.partydim2<0|new.partydim2>(sqrt(2)/2)) {
           new.partydim2 <- ifelse(new.partydim2<0, 0, (sqrt(2)/2))
       }
   }
  return(list(partydim1=new.partydim1,
              partydim2=new.partydim2)
         )     
 }
sat.governator <- cmpfun(sat.governator)

partyplacer <- function(p, rule, electionst1, electionst2, partydim1, partydim2,
                        speed, vprefdim1, vprefdim2, vote,  govdim1, govdim2,
                        partydim1t2, partydim2t2, direction1, direction2, gov) {
  partypos <- NaN
   #Use aggregator rule
  if (rule==2){
   partypos <- aggregator(partydim1, partydim2, vprefdim1, vprefdim2, vote, p, speed)
  } else  if(rule==3){ #Use classical.governator rule
   partypos <- sat.governator(partydim1, partydim2, speed, govdim1, govdim2, gov)
  } else   if(rule==4){   #Use sticker rule
   partypos <- list(partydim1=partydim1, partydim2=partydim2)
  } else   if(rule==7){ #Use satisficing hunter rule
   partypos <- hunter(electionst1,
                         electionst2,
                         partydim1,
                         direction1,
                         partydim2,
                         direction2,
                         speed)
  } else { #Use hunting.governator rule
   partypos <- governator(partydim1, partydim2, speed, govdim1, govdim2)
  } 
 return(partypos)
}
partyplacer <- cmpfun(partyplacer)

evolutioner <- function(util, aspiration, potential.rules, rule) {
 #get random rule if rule is not new (>memory) and mean util below aspiration, else keep rule.
    #if rule not used for entire memory period (=rule is relatively new), keep rule.
    keep <- ifelse(apply(rule, 2, function(x) length(unique(x)))==1, 0,1)
    #get parties below aspirations.
    below <- ifelse(apply(util, 2, mean)<aspiration, 1, 0)
    #get a new rule chosen for each party.
    new <- sample(potential.rules, length(keep), TRUE)
    #decide whether new rule needed.
    return(ifelse(keep==0&below==1, new, rule[nrow(rule),]))
}
evolutioner <- cmpfun(evolutioner)

utilizer <-  function(alpha, utilityP, utilityS){
 return((alpha*utilityP)+((1-alpha)*utilityS))
}
utilizer <- cmpfun(utilizer)


eff.num.rule <- function(shares) {
    return(1/sum(shares*shares))
}
eff.num.rule <- cmpfun(eff.num.rule)


eccentriciter <- function(partydim1, partydim2, mean.vprefdim1, mean.vprefdim2) {
   return(.Internal(mean(sqrt((partydim1-mean.vprefdim1)^2+(partydim2-mean.vprefdim2)^2))))
}
eccentriciter <- cmpfun(eccentriciter)

## # forming coalition government
product <- function(allc, elections){allc*elections}
product <- cmpfun(product)

seater <- function(seatsc,sumseats){seatsc/sumseats}
seater <- cmpfun(seater)

euclidean.distancer <- function(moving, target1, target2) {
    sqrt(((moving[1]-target1)^2)+((moving[2]-target2)^2))
}
euclidean.distancer <- cmpfun(euclidean.distancer)

check.in.parliament <- function(allc, elections) {
     return(ifelse(any(elections[allc==1]==0),0,1))
 }
check.in.parliament <- cmpfun(check.in.parliament)

compare <- function(utility, cur.util) {
    utility >= cur.util
}
compare <- cmpfun(compare)

   
utilizerP.gov.given <- function(pprefdim1, pprefdim2, govpos){
    1-(sqrt(
        (pprefdim1-govpos[1])^2+(pprefdim2-govpos[2])^2
        )^2)
}
utilizerP.gov.given <- cmpfun(utilizerP.gov.given)

#this function is used for initilization only
utilizerP <- function(pprefdim1, seatsc, sumseats, partydim1All, pprefdim2, partydim2All){
1- (sqrt(((pprefdim1 - sum((seater(seatsc,sumseats))*t(partydim1All)))^2)
  + ((pprefdim2 - sum((seater(seatsc,sumseats))*t(partydim2All)))^2)
 )^2) 
}

